<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="main" script:language="StarBasic">REM  *****  BASIC  *****
Option Compatible

Dim Oxia
Dim Varia
Dim Zvatelce
Dim Kamora
Dim Titlo
Dim Pokrytie
Dim SUnder


sub InitSymbols
	Oxia		= chr(&amp;H0301)
	Varia		= chr(&amp;H0300)
	Zvatelce	= chr(&amp;H0486)
	Kamora		= chr(&amp;H0311)
	Titlo		= chr(&amp;H0483)
	Pokrytie = chr(&amp;H0487)
	SUnder = chr(&amp;H2DED)
end sub	

Function getCharStyleForParaStyle(oParStyleName$, Optional bSmall as Boolean)
REM получить имя символьного стиля для sParaStyleName 
	Dim pst_TextBody$, pst_Irmos_18$, pst_Small_18_WoRedLine$, pst_Small_18$, pst_Small_16$, pst_Irmos_16$ REM paragraph styles
	Dim pst_ParaLettrine$, pst_ParaLettrine_1up$, pst_ParaLettrine_2up$
	Dim pst_Ustav$, pst_UstavLeft$, pst_UstavCentered$
	Dim pst_ParaBigLettrine$, pst_ParaBigLettrine_1up$, pst_ParaBigLettrine_2up$
	Dim pst_TextBodyWoRedLine$
	Dim pst_Glas$
	Dim chst_Kinovar$, chst_Kinovar_18$, chst_Kinovar_16$, chst_KinovarBlack$, chst_KinovarBlack_18$, chst_KinovarBlack_16$ REM Char styles
	Dim sCharStyleName$
	
	REM Выдавать результат только для малых стилей, для любых остальных - &quot;киноварь&quot;
	If IsMissing(bSmall) Then bSmall = False
	
	pst_TextBody = &quot;Text body&quot;
	pst_Irmos_18 = &quot;Ирмос 18&quot;
	pst_Small_18_WoRedLine = &quot;Малый 18 без красной строки&quot;
	pst_Small_18 = &quot;Малый 18&quot;
	pst_Small_16 = &quot;Малый 16&quot;
	pst_Irmos_16 = &quot;Ирмос 16&quot;
	pst_Glas = &quot;Глас&quot;
	
	pst_ParaLettrine = &quot;Абзац с буквицей&quot;
	pst_ParaLettrine_1up = &quot;Абзац с буквицей и надстрочник&quot;
	pst_ParaLettrine_2up = &quot;Абзац с буквицей и два надстрочника&quot;

	pst_ParaBigLettrine = &quot;Абзац с большой буквицей&quot;
	pst_ParaBigLettrine_1up = &quot;Абзац с большой буквицей и надстрочник&quot;
	pst_ParaBigLettrine_2up = &quot;Абзац с большой буквицей и два надстрочника&quot;

	pst_TextBodyWoRedLine = &quot;Без красной строки&quot;

	pst_Ustav = &quot;Устав&quot;
	pst_UstavLeft = &quot;Устав влево&quot; 
	pst_UstavCentered = &quot;Устав по центру&quot;
	
	pst_DateAndPlace = &quot;Дата и место&quot;
	pst_DateAndPlaceInText = &quot;Дата и место в тексте&quot;

	chst_Kinovar = &quot;киноварь&quot;
	chst_Kinovar_18 = &quot;киноварь 18&quot; 
	chst_Kinovar_16 = &quot;киноварь 16&quot; 
	chst_KinovarBlack = &quot;киноварь черная&quot;
	chst_KinovarBlack_18 = &quot;киноварь 18 черная&quot; 
	chst_KinovarBlack_16 = &quot;киноварь 16 черная&quot; 
	
	If bSmall Then
		If oParStyleName = pst_Small_18 _
			OR oParStyleName = pst_Small_18_WoRedLine _
			OR oParStyleName = pst_Irmos_18 Then
		
			sCharStyleName = chst_Kinovar_18
	
		ElseIf oParStyleName = pst_Small_16 _
			OR oParStyleName = pst_Irmos_16 Then
			sCharStyleName = chst_Kinovar_16
			
		ElseIf oParStyleName = pst_Ustav _
			OR oParStyleName = pst_UstavLeft _
			OR oParStyleName = pst_UstavCentered _
			OR oParStyleName = pst_Glas Then
			sCharStyleName = chst_KinovarBlack_18

		ElseIf oParStyleName = pst_DateAndPlace _
			OR oParStyleName = pst_DateAndPlaceInText Then
			sCharStyleName = &quot;&quot;
			
		Else sCharStyleName = chst_Kinovar
		End If

	Else
		If oParStyleName = pst_TextBody _
			OR oParStyleName = pst_ParaLettrine _
			OR oParStyleName = pst_ParaLettrine_1up _
			OR oParStyleName = pst_ParaLettrine_2up _
			OR oParStyleName = pst_ParaBigLettrine _
			OR oParStyleName = pst_ParaBigLettrine_1up _
			OR oParStyleName = pst_ParaBigLettrine_2up _
			OR oParStyleName = pst_TextBodyWoRedLine Then
	
			sCharStyleName = chst_Kinovar
		
		ElseIf oParStyleName = pst_Small_18 _
			OR oParStyleName = pst_Small_18_WoRedLine _
			OR oParStyleName = pst_Irmos_18 Then
		
			sCharStyleName = chst_Kinovar_18
	
		ElseIf oParStyleName = pst_Small_16 _
			OR oParStyleName = pst_Irmos_16 Then
			sCharStyleName = chst_Kinovar_16
		
		ElseIf oParStyleName = pst_Ustav _
			OR oParStyleName = pst_UstavLeft _
			OR oParStyleName = pst_UstavCentered _
			OR oParStyleName = pst_Glas Then
			sCharStyleName = chst_KinovarBlack_18

		Else sCharStyleName = &quot;&quot;
		End If
	
	End If
	getCharStyleForParaStyle = sCharStyleName

End Function



Sub SetKinovarToParaWithStyle()
REM Set kinovar to first letter for all paragraphs with &quot;Text Body&quot; style.
	Dim pst_TextBody$, pst_Irmos_18$, pst_Small_18_WoRedLine$, pst_Small_18$, pst_Small_16$, pst_Irmos_16$ REM paragraph styles
	Dim oDoc
	Dim oText
	Dim oParEnum
	Dim oPar
	Dim oParStyleName$, sCharStyleName$
	Dim oStart, oEnd
	Dim oCursor

	
	InitSymbols
	
	oDoc = ThisComponent
	
	pst_TextBody = &quot;Text body&quot;
	pst_Irmos_18 = &quot;Ирмос 18&quot;
	pst_Small_18_WoRedLine = &quot;Малый 18 без красной строки&quot;
	pst_Small_18 = &quot;Малый 18&quot;
	pst_Small_16 = &quot;Малый 16&quot;
	pst_Irmos_16 = &quot;Ирмос 16&quot;

	
	oText = oDoc.getText()
	oParEnum = oText.createEnumeration()
	While oParEnum.hasMoreElements()
		oPar = oParEnum.nextElement()
		oParStyleName = oPar.ParaStyleName
		If oParStyleName = pst_TextBody _
			OR oParStyleName = pst_Small_18 _
			OR oParStyleName = pst_Small_18_WoRedLine _
			OR oParStyleName = pst_Irmos_18 _
			OR oParStyleName = pst_Small_16 _
			OR oParStyleName = pst_Irmos_16 Then
			oStart = oPar.getStart()
			oCursor = oText.createTextCursorByRange(oStart)	
			
			sCharStyleName = getCharStyleForParaStyle(oParStyleName)
			If sCharStyleName &lt;&gt; &quot;&quot; Then
				setKinovarToTextCursor(oCursor, sCharStyleName)
			Else exit sub
			End If 
		End If 
	WEnd
End Sub

Sub SetKinovarToCursor(oCursor, KinovarStyleName$)
rem установить для текста в курсоре стиль киноварь
	Dim oStyleFamilies As Variant
	Dim oStyleFamilie As Variant
	Dim newChStyle
	
    &apos; стили в документе
    oStyleFamilies = ThisComponent.getStyleFamilies()
    &apos; символьные стили
    oStyleFamilie = oStyleFamilies.getByName(&quot;CharacterStyles&quot;)
    
    &apos; Проверка, если нет стиля киноварь, создать 
    if oStyleFamilie.hasByName(KinovarStyleName) = False then
    	print &quot;Нет стиля &quot; &amp; KinovarStyleName &amp; &quot;, создаем&quot;
    	newChStyle = ThisComponent.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
    	With newChStyle 
    		.setName(KinovarStyleName)
    		.CharColor = 16711680 &apos; red3
    		.CharFontName = &quot;Ponomar Unicode&quot;
    	End With 
    	oStyleFamilie.insertByName(KinovarStyleName, newChStyle)
    End if
	
	&apos; Применить стиль
	oCursor.CharStyleName = KinovarStyleName
End Sub
&apos;------------------------------------------------

Sub SetKinovar()
	&apos; установить для первой буквы в абзаце
	&apos; стиль киноварь
	&apos; вместе с надстрочниками 
 	&apos; BasicLibraries.LoadLibrary(&quot;XrayTool&quot;)
	Dim oDoc
	Dim oVC, oTC
	&apos;Dim chrst_Kinovar$
	Dim sParaStyleName$
	Dim sCharStyleName$


	InitSymbols
	&apos;chrst_Kinovar = &quot;киноварь&quot;
	
	oDoc = ThisComponent
   	oVC = oDoc.CurrentController.getViewCursor()
   	oTC = oVC.Text.createTextCursorByRange(oVC)
   	sParaStyleName = oTC.ParaStyleName
	sCharStyleName = getCharStyleForParaStyle(sParaStyleName, True)
	If sCharStyleName &lt;&gt; &quot;&quot; Then
		oTC.gotoStartOfParagraph(False)
		GrabFirstLetterWithSubscriptsAndSetKinovar(oTC, sCharStyleName)
   	End If
   	
End Sub

Sub GrabFirstLetterWithSubscriptsAndSetKinovar(vTC, CharStyleName$)
REM В переданном курсоре (vTC) захватывает первую букву (с надстрочниками, если есть).
REM и устанавливает киноварь (CharStyleName) для нее.
REM Курсор уже в начале слова.

   	With vTC
	   	REM Первый символ
	   	.goRight(1, True)
	   	SetKinovarToCursor(vTC, CharStyleName)
	   	.CollapseToEnd
		 
		REM Надстрочники	   	
	   	.goRight(1, True)
	   	REM Второй символ, звательце (или титло) или с под покрытием 
	   	if .getString = Zvatelce or .getString = Titlo or .getString = SUnder Then
	   		SetKinovarToCursor(vTC, CharStyleName)
	   		.CollapseToEnd
	   		.goRight(1, True)
	   		REM Третий символ - оксия  или вария или покрытие
	   		If .getString = OXia OR .getString = Varia OR .getString = Pokrytie  Then
				SetKinovarToCursor(vTC, CharStyleName)
			End If
		End If  	
	End With
End Sub


Sub setKinovarToTextCursor(tc, chst)
   	tc.gotoStartOfParagraph(False)
   	GrabFirstLetterWithSubscriptsAndSetKinovar(tc, chst)
End Sub


Sub setKinToSelected()
&apos;BasicLibraries.LoadLibrary(&quot;XrayTool&quot;)
	&apos; установить для выделенного текста
	&apos; стиль киноварь.\
	&apos; Для малых абзацных стилей (18 и 16 кегля) стили символов соотв-е.
	&apos; Для всех остальных - киноварь (20)
	Dim all_selections
	Dim first_selection
	Dim oDoc, oTC
	Dim sParaStyleName$
	Dim sCharStyleName$

	oDoc = ThisComponent
    all_selections = oDoc.getCurrentController().getSelection()
    first_selection = all_selections.getByIndex(0)
   	oTC = oDoc.Text.createTextCursorByRange(first_selection)
	sParaStyleName = oTC.ParaStyleName
	sCharStyleName = getCharStyleForParaStyle(sParaStyleName, True)
	If sCharStyleName &lt;&gt; &quot;&quot; Then
		SetKinovarToCursor(oTC, sCharStyleName)
	End If
	
End sub

Sub RemoveKinovar()
	REM Удаляет киноварные символьные стили у первых n символов в абзаце, в котором находится курсор.
	Dim oDoc
	Dim oVC, oTC
	Dim sCharStyleName$
	Dim chst_NoStyle$

	oDoc = ThisComponent
   	oVC = oDoc.CurrentController.getViewCursor()
   	oTC = oVC.Text.createTextCursorByRange(oVC)

   	RemoveCharStyleFromTextCursor(oTC)

End Sub

Sub RemoveCharStyleFromTextCursor(tc)
	Dim chst_NoStyle$
	Dim bCharStyleIsKinovar as Boolean
	
	chst_NoStyle = &quot;Standard&quot;
	
	tc.gotoStartOfParagraph(False)
	
	Do   	
		tc.goRight(1, True)
	   	sCharStyleName = tc.CharStyleName
	   	bCharStyleIsKinovar = ifCharStyleIsKinovar(sCharStyleName)
	   	If bCharStyleIsKinovar = False Then Exit Do
	   	tc.CharStyleName = chst_NoStyle	
	   	tc.CollapseToEnd()
	   	
	Loop While bCharStyleIsKinovar

End Sub

Function ifCharStyleIsKinovar(chst) as Boolean
	Dim chst_Kinovar$, chst_Kinovar_18$, chst_Kinovar_16$, chst_KinovarBlack$, chst_KinovarBlack_18$, chst_KinovarBlack_16$ REM Char styles
	
	chst_Kinovar = &quot;киноварь&quot;
	chst_Kinovar_18 = &quot;киноварь 18&quot; 
	chst_Kinovar_16 = &quot;киноварь 16&quot; 
	chst_KinovarBlack = &quot;киноварь черная&quot;
	chst_KinovarBlack_18 = &quot;киноварь 18 черная&quot; 
	chst_KinovarBlack_16 = &quot;киноварь 16 черная&quot; 
   	If chst = chst_Kinovar _
   		OR chst = chst_Kinovar_18 _
   		OR chst = chst_Kinovar_16 _
   		OR chst = chst_KinovarBlack _
   		OR chst = chst_KinovarBlack_18 _
   		OR chst = chst_KinovarBlack_16 Then
   		
   		ifCharStyleIsKinovar = True
   	
	Else ifCharStyleIsKinovar = False
	End If

End Function

Sub RemoveKinovarFromSelected()
REM Удаляет киноварные символьные стили у выделенных символов.
	Dim all_selections
	Dim first_selection
	Dim oDoc, oTC
	Dim chst_NoStyle$

	chst_NoStyle = &quot;Standard&quot;

	oDoc = ThisComponent
    all_selections = oDoc.getCurrentController().getSelection()
    first_selection = all_selections.getByIndex(0)
   	oTC = oDoc.Text.createTextCursorByRange(first_selection)
	oTC.CharStyleName = chst_NoStyle
   	
End Sub


</script:module>